module Text.XML.XsdAliases
    where
    
import Language.XMLSchema.Parse
import Text.XML.HaXml.Parse
import Text.XML.HaXml.Pretty
import Text.XML.HaXml.Xml2Haskell (fromElem,toElem)
import IO
import Text.XML.HaXml.Types

import StrategyLib

import Language.XMLSchema.NameSpaces 
        (createNameSpaceEnv,xmlSchemaPrefixes,Schema)

-- | Parses a XSD file into Joost Visser's XML 'Schema' type.
parseXsd :: MonadPlus m => ChaseName -> IO (m Schema) 
parseXsd relativeName = do
  fileContent <- readFile relativeName
  let (Document _ _ xmlElement) = xmlParse relativeName fileContent
  let nse = createNameSpaceEnv xmlElement 
  let xsPfxs = Prelude.filter (/="xs") $ xmlSchemaPrefixes nse
  let (_,xmlElement',nse')
        = reparseIfNeeded xsPfxs fileContent (relativeName,xmlElement,nse)
  let maybeSchema = (fst (fromElem [CElem xmlElement']))
  case maybeSchema of
    Nothing     -> fail $ "Parse error in schema: "++relativeName
    (Just xs)   -> return $ return (relativeName,xmlElement',xs,nse',relativeName)
						
doc2Xsd :: MonadPlus m => FilePath -> Document -> m Schema
doc2Xsd relativeName doc@(Document _ _ xmlElement) = do
  let fileContent = show $ document doc
  let nse = createNameSpaceEnv xmlElement 
  let xsPfxs = Prelude.filter (/="xs") $ xmlSchemaPrefixes nse
  let (_,xmlElement',nse')
        = reparseIfNeeded xsPfxs fileContent (relativeName,xmlElement,nse)
  let maybeSchema = (fst (fromElem [CElem xmlElement']))
  case maybeSchema of
    Nothing     -> fail $ "Parse error in schema: "++relativeName
    (Just xs)   -> return (relativeName,xmlElement',xs,nse',relativeName)

xsd2doc :: MonadPlus m => Schema -> m Document
xsd2doc (_,_,xs,_,_) = do
	[CElem doc] <- return $ toElem xs
	return (Document (Prolog Nothing Nothing) [] doc)


